DEFINT a-z
eingelesen=0
DECLARE FUNCTION Execute& LIBRARY
DECLARE FUNCTION xOpen&  LIBRARY
 5 ON ERROR GOTO 0
10 CLS:LOCATE 5,5:PRINT "Installation der Comicverwaltung"
20 LOCATE 8,5:PRINT "1. volle Installation"
30 LOCATE 10,5:PRINT "2. Druckervoreinstellung"
40 LOCATE 12,5:PRINT "3. Voreinstellung für Ausdruck"
50 LOCATE 14,5:PRINT "4. Anzahl der Zustände ändern"
   LOCATE 16,5:PRINT "5. zusätzliche Diskette einrichten"
   LOCATE 18,5:PRINT "6. Ende"
60 q$=INKEY$
70 IF q$<"1" OR q$>"6" THEN SLEEP:GOTO 60
70 ON VAL(q$) GOTO 100,200,300,400,500,80
80 SYSTEM

100 CLS
110 LOCATE 2,30:PRINT "Installation"
120 LOCATE 4,5:PRINT "Das Programm benötigt die dos.library."
130 LOCATE 5,5:PRINT "Geben Sie bitte den vollständigen Pfad dazu ein:"
140 INPUT lib$
150 IF UCASE$(RIGHT$(lib$,11))="DOS.LIBRARY" THEN lib$=LEFT$(lib$,LEN(lib$)-11
    IF (RIGHT$(lib$,1)<>"/" AND RIGHT$(lib$,1)<>":")AND LEN(lib$)>0 THEN lib$=lib$+"/"
    ON ERROR GOTO libfehler
    LIBRARY lib$+"dos.library"
 LOCATE 7,5:PRINT "Geben Sie jetzt bitte an, wo sich die Comicverwaltung"
 LOCATE 8,5:PRINT "befindet (vollst. Pfad)."
 ON ERROR GOTO fehler 
cv: LOCATE 9,5:INPUT cvpfad$
  IF cvpfad$="" THEN cv
 IF (RIGHT$(cvpfad$,1)<>"/")AND(RIGHT$(cvpfad$,1)<>":")AND LEN(cvpfad$)>0 THEN cvpfad$=cvpfad$+"/"
 fehler=0
 OPEN cvpfad$+"Start" FOR INPUT AS 1  'comicprg----------------------
 CLOSE 1
 IF fehler THEN LOCATE 20,5:PRINT "Comicverwaltung nicht gefunden":GOTO cv
 ON ERROR GOTO 0
 LOCATE 10,5:PRINT "Geben Sie jetzt bitte an, wo die Comicverwaltung installiert"
 LOCATE 11,5:PRINT "werden soll (vollst. Pfad)."
 GOSUB pfadeingabe
 LOCATE 13,5:PRINT "Welches Laufwerk soll für Zwischenspeicherungen verwendet werden"
 LOCATE 14,5:PRINT " (RAM: oder RAD:) ? "
155 LOCATE 14,27:INPUT lw$
 lw$=UCASE$(lw$)
 IF lw$<>"RAM:" AND lw$<>"RAD:" THEN
   LOCATE 15,5:PRINT "Wirklich "lw$" (j/n)?"
   q$=""
   WHILE q$<>"j" AND q$<>"n"
     SLEEP:q$=INKEY$
   WEND
   IF q$="n" THEN 155
 END IF    
  ON ERROR GOTO 0
  fHandle& = xOpen&(SADD("con:0/0/600/100/"+CHR$(0)),1005)
  IF fHandle& = 0 THEN PRINT:PRINT  "Fehler im DOS":taste:LIBRARY CLOSE:GOTO 10
  x=Execute&(SADD("makedir "+cpfad$+"comp"+CHR$(0)), 0,fHandle&)
  x=Execute&(SADD("makedir "+cpfad$+"comdat"+CHR$(0)), 0,fHandle&)
  x=Execute&(SADD("copy "+cvpfad$+"comic.haupt "+cpfad$+"comic.haupt"+CHR$(0)), 0,fHandle&)
  x=Execute&(SADD("copy "+cvpfad$+"start "+cpfad$+"start"+CHR$(0)), 0,fHandle&)
  x=Execute&(SADD("copy "+cvpfad$+"start.info "+cpfad$+"start.info"+CHR$(0)), 0,fHandle&)
  pfad$=cpfad$+"comp/"
 CALL xClose&(fHandle&)  
 LIBRARY CLOSE      
 LOCATE 16,5:PRINT "Vor der Neuanlage müssen Sie noch festlegen, wieviele verschiedene"
 LOCATE 17,5:PRINT "Zustände Sie unterscheiden wollen (1-10) :"
170 LOCATE 17,48:INPUT "",zmax$
 zmax!=VAL(zmax$):IF zmax! < 1 OR zmax! > 10 OR INT(zmax!)<> zmax! THEN 170
 zmax=VAL(zmax$)
 OPEN pfad$+"Zahlen" AS 1 LEN=2
 FIELD 1,2 AS d$
 LSET d$=MKI$(0):PUT 1,1
 LSET d$=MKI$(zmax):PUT 1
 CLOSE 1 
 OPEN pfad$+"Titel" AS 1 LEN=34
 FIELD 1,34 AS d$
 LSET d$=" ":PUT 1,1
 CLOSE 1 
 OPEN pfad$+"Index" AS 1 LEN=2
 FIELD 1,2 AS d$
 LSET d$=MKI$(0):PUT 1,1
 CLOSE 1
 OPEN pfad$+"Voreinstellung" AS 1 LEN=1
 FIELD 1,1 AS d$
 d$=CHR$(0):PUT 1,1
 CLOSE 1
GOSUB drucker
GOSUB ausdruck
GOTO 10

libfehler:
  PRINT "Die dos.library wurde nicht gefunden. (Taste)"
  taste
  RESUME 5
pfadfehler:
  LOCATE 23,5:PRINT "ungültiger Pfad"
  RESUME pfadeingabe
fehler:
  fehler=ERR
  RESUME NEXT  
SUB taste STATIC
  rq$=""
  WHILE rq$=""
    SLEEP:rq$=INKEY$
  WEND  
END SUB
drucker:
   OPEN pfad$+"Drucker" FOR OUTPUT AS 1
     PRINT #1,cpfad$
     PRINT #1,lib$
     PRINT #1,lw$
     PRINT #1,CHR$(34)+CHR$(27)+CHR$(64)+CHR$(17)+CHR$(34)
     PRINT #1,CHR$(34)+CHR$(10)+CHR$(34)
     PRINT #1,CHR$(34)+CHR$(27)+CHR$(77)+CHR$(27)+CHR$(15)+CHR$(34)
     PRINT #1,CHR$(34)+"PAR:"+CHR$(34)
     PRINT #1,MKI$(72);
     PRINT #1,MKI$(72);
     PRINT #1,MKI$(160)
   CLOSE 1
RETURN
daten:
DATA "Vorhandene",1,"<<",">> ",,
DATA "Fehlende",0,"<<",">> ",,
DATA "Mehrfache",5,"<<",">> ",,
DATA "Vorhandene zusammengefaßt",9,"<<",">> ",,
DATA "Vorhandene mit Zustand",17,"<<",">> ",,
DATA "Vorhandene zus. mit Zustand",33,"<<",">> ",,
DATA "Alle",3,"<<",">> ",(,)
DATA "Alle mit Zustand",19,"<<",">> ",(,)
DATA "Alle zus. mit Zustand",35,"<<",">> ",(,)

ausdruck:
     OPEN pfad$+"Druckart" AS 1 LEN=107
      FIELD 1,30 AS d$,1 AS bed$,1 AS lg$,5 AS t1$,5 AS t2$,1 AS lg2$,5 AS t3$,5 AS t4$,4 AS lg3$,50 AS t5$
      RESTORE daten
      FOR i=0 TO 8
       READ q$:LSET d$=q$
       READ q:LSET bed$=CHR$(q)
       READ q$:LSET t1$=q$:q=LEN(q$)
       READ q$:LSET t2$=q$:q=q*16+LEN(q$)
       LSET lg$=CHR$(q)
       READ q$:LSET t3$=q$:q=LEN(q$)
       READ q$:LSET t4$=q$:q=16*q+LEN(q$)
       LSET lg2$=CHR$(q)
       IF i=5 OR i=8 THEN
        LSET lg3$=MKL$(153391689)
        LSET t5$="0    1    2    3    4    5    6    7    8    9    "
       END IF
       PUT 1,i+1
      NEXT
     CLOSE 1
     RESET
RETURN
200 CLS:fehler=0:cpfad$="":i=0:lw$=""
210 ON ERROR GOTO fehler
    OPEN cpfad$+"comp/Drucker" FOR INPUT AS 1
    IF fehler>0 AND i=0 THEN
      i=1
  211 LOCATE 5,5:PRINT "Bitte geben Sie den vollst. Pfad zur Comicverwaltung an :"
      GOSUB pfadeingabe
      IF INSTR(cpfad$,":")=0 THEN 211
      fehler=0:ON ERROR GOTO fehler
      OPEN cpfad$+"comp/Index" FOR INPUT AS 1
      CLOSE 1
      IF fehler>0 THEN LOCATE 20,5:"falscher Pfad (Taste)":taste:GOTO 211
      GOTO 210
    ELSEIF fehler>0 AND i=1 THEN
      LOCATE 8,5:PRINT "Bitte den Pfad zur DOS.LIBRARY angeben"
      INPUT lib$
      IF UCASE$(RIGHT$(lib$,11))="DOS.LIBRARY" THEN lib$=LEFT$(lib$,LEN(lib$)-11)
      IF (RIGHT$(lib$,1)<>"/" AND RIGHT$(lib$,1)<>":")AND LEN(lib$)>0 THEN lib$=lib$+"/"
      ON ERROR GOTO libfehler
      LIBRARY lib$+"dos.library"
      LIBRARY CLOSE
    ELSE
      INPUT#1,cpfad$
      INPUT#1,lib$
      INPUT#1,lw$
      CLOSE 1
    END IF
      LOCATE 10,1:PRINT "Welches Laufwerk soll für Zwischenspeicherungen verwendet werden"
      LOCATE 11,1:PRINT "(RAM: oder RAD:) ? "
      IF lw$<>"" THEN LOCATE 11,21:PRINT "CR = ";lw$
      q$=""
  215 INPUT q$
      IF q$<>"" THEN lw$=q$
      lw$=UCASE$(lw$)
      IF lw$<>"RAM:" AND lw$<>"RAD:" THEN
        LOCATE 12,5:PRINT "Wirklich "lw$" (j/n)?"
        q$=""
        WHILE q$<>"j" AND q$<>"n"
          SLEEP:q$=INKEY$
        WEND
        IF q$="n" THEN 215  
      END IF
    pfad$=cpfad$+"comp/"
    GOSUB drucker
    GOTO 5
pfadeingabe: 
 ON ERROR GOTO pfadfehler 
 INPUT cpfad$
 IF (RIGHT$(cpfad$,1)<>"/")AND(RIGHT$(cpfad$,1)<>":")AND LEN(cpfad$)>0 THEN cpfad$=cpfad$+"/"
dum:
 OPEN cpfad$+"com.dummy" FOR OUTPUT AS 1
 CLOSE 1
 KILL cpfad$+"com.dummy"
 ON ERROR GOTO 0
RETURN
300 CLS
    LOCATE 5,5:PRINT "Bitte geben Sie ein, wohin die Voreinstellung kopiert"
    LOCATE 6,5:PRINT "werden soll :"
    GOSUB pfadeingabe
    IF UCASE$(RIGHT$(cpfad$,5))="COMP/" THEN
      pfad$=cpfad$
    ELSE
      pfad$=cpfad$
      IF RIGHT$(pfad$,1)<>":" AND RIGHT$(pfad$,1)<>"/" AND LEN(pfad$)>0 THEN pfad$=pfad$+"/"
      pfad$=pfad$+"comp/"
    END IF
    ON ERROR GOTO fehler:fehler=0
    OPEN cpfad$+"com.dummy" FOR OUTPUT AS 1
    IF fehler>0 THEN LOCATE 20,5:PRINT "Unterverzeichnis nicht gefunden (Taste)":taste:GOTO 5
    CLOSE 1
    KILL cpfad$+"com.dummy"
    ON ERROR GOTO 0
    GOSUB ausdruck
    GOTO 10
400 CLS
IF NOT eingelesen THEN    
  DIM dec(83),cod(43),dat(10),ndat(10),nz(10)
  RESTORE cod
  FOR i=0 TO 43:READ q$:cod(i)=VAL("&h"+q$):NEXT i
  FOR i=0 TO 83:READ q$:dec(i)=VAL("&h"+q$):NEXT i
  eingelesen=-1
END IF
    LOCATE 5,5:PRINT "Bitte geben Sie den Pfad zum Comicprogramm ein."
    GOSUB pfadeingabe
    ON ERROR GOTO fehler:fehler=0
    OPEN cpfad$+"comp/Zahlen" FOR INPUT AS 1
    CLOSE 1
    q=fehler
    OPEN cpfad$+"comp/Titel" FOR INPUT AS 1
    CLOSE 1
    IF q+fehler>0 THEN LOCATE 20,5:PRINT "Dateien nicht gefunden (Taste)":taste:GOTO 5
    ON ERROR GOTO 0
    OPEN cpfad$+"comp/Zahlen" AS 1 LEN=2
    FIELD 1,2 AS d$
    GET 1,1:an=CVI(d$):GET 1:zmax=CVI(d$):satzl=(zmax+2)\2
    IF an=0 THEN CLOSE 1:GOTO 10
    CLS
    LOCATE 3,5:PRINT "Wieviele Zustände werden gewünscht (1-10) ?"
    nzmax=0
    WHILE nzmax<1 OR nzmax>10 OR nzmax=zmax
      LOCATE 3,50:INPUT nzmax
    WEND
    nsatzl=(nzmax+2)\2
    LOCATE 4,5:PRINT "Ordnen Sie jetzt den alten Zuständen je einen neuen zu"
    LOCATE 5,5:PRINT "alter Zustand     neuer Zustand"
    FOR i=0 TO zmax-1
      LOCATE 6+i,10:PRINT i
      nz(i)=-1
      WHILE nz(i)<0 OR nz(i)>=nzmax
        LOCATE 6+i,18:INPUT nz(i)
      WEND
    NEXT i    
    OPEN cpfad$+"comp/Zahlen.neu" AS 2 LEN=2
    FIELD 2,2 AS d2$
    LSET d2$=MKI$(an):PUT 2,1
    LSET d2$=MKI$(nzmax):PUT 2,2
    FOR i=1 TO an
      FOR j=0 TO nzmax-1:z(j)=0:NEXT j
      FOR j=0 TO zmax-1
        GET 1,(i-1)*(zmax+2)+j+3:z(nz(j))=z(nz(j))+CVI(d$)
      NEXT j
      FOR j=0 TO nzmax-1
        LSET d2$=MKI$(z(j)):PUT 2
      NEXT j
      GET 1:LSET d2$=d$:PUT 2
      GET 1:LSET d2$=d$:PUT 2  
    NEXT i
    CLOSE 1
    CLOSE 2
    pfad$=cpfad$+"comdat/"
    OPEN cpfad$+"comp/Titel" AS 1 LEN=34
     FIELD 1,1 AS laenge$,30 AS d$,1 AS jahr$,2 AS mnr$
     nummer=0
     FOR i=1 TO an
       GET 1,i:t$=LEFT$(d$,ASC(laenge$))
       LOCATE 18,5:PRINT USING "\                            \";t$
pf:    ON ERROR GOTO fehler:fehler=0
       OPEN pfad$+t$ FOR INPUT AS 2
       CLOSE 2
       ON ERROR GOTO 0
       IF fehler>0 THEN
         LOCATE 20,5:PRINT "Datei nicht gefunden"
         LOCATE 21,5:PRINT "bitte den richtigen Pfad eingeben :":INPUT pfad$
         IF RIGHT$(pfad$,1)="/" THEN pfad$=LEFT$(pfad$,LEN(pfad$)-1)
         IF RIGHT$(pfad$,6)<>"comdat" THEN
           IF RIGHT$(pfad$,1)<>":" THEN pfad$=pfad$+"/"
           pfad$=pfad$+"comdat"
         END IF
         pfad$=pfad$+"/"
         GOTO pf
       END IF
       OPEN pfad$+t$ AS 2 LEN=satzl
       FIELD 2,satzl AS d2$
       IF LEN(t$)<26 THEN
         OPEN pfad$+t$+".neu" AS 3 LEN=nsatzl
       ELSE
         OPEN pfad$+"xxyyzzy"+STR$(nummer) AS 3 LEN=nsatzl
         nummer=nummer+1
       END IF
       FIELD 3,nsatzl AS d3$
       l=LOF(2)/satzl
       FOR j=1 TO l
         GET 2,j
         decodiere d2$
         FOR k=1 TO nzmax:ndat(k)=0:NEXT k
         ndat(0)=dat(0)
         IF ndat(0)=0 THEN
           FOR k=0 TO zmax-1
             ndat(nz(k)+1)=ndat(nz(k)+1)+dat(k+1)
           NEXT k
           codiere q$
           LSET d3$=q$
         ELSE
           LSET d3$=CHR$(240)+STRING$(nsatzl-1,0)
         END IF
         PUT 3,j
       NEXT j
     CLOSE 2:CLOSE 3
     NEXT i
   CLOSE 1
  KILL cpfad$+"comp/Zahlen"
  NAME cpfad$+"comp/Zahlen.neu" AS "comp/Zahlen"
  OPEN cpfad$+"comp/Titel" AS 1 LEN=34
  FIELD 1,1 AS laenge$,30 AS d$,1 AS jahr$,2 AS mnr$
  nummer=0
  FOR i=1 TO an
    GET 1,i:t$=LEFT$(d$,ASC(laenge$))
    KILL pfad$+t$
    IF LEN(t$)<26 THEN
         NAME pfad$+t$+".neu" AS pfad$+t$
       ELSE
         NAME pfad$+"xxyyzzy"+STR$(nummer) AS pfad$+t$
         nummer=nummer+1
       END IF
    q$=LEFT$(t$+".info",30)
    ON ERROR GOTO fehler
    IF q$<>t$ THEN KILL pfad$+t$+".info"
    ON ERROR GOTO 0
  NEXT i
  CLOSE 1
  ON ERROR GOTO fehler
  FOR i=0 TO nummer
    KILL pfad$+"xxyyzzy"+STR$(i)+".info"
  NEXT i
  ON ERROR GOTO 0
  GOTO 5  
  
cod:
DATA 0000,0000,0000,0011,0000,03E9,0000,0011
DATA 48E7,F0C0,206F,001C,226F,0020,222F,0024
DATA 5341,E249,6500,0006,343C,0001,3019,E988
DATA 3619,0243,000F,D003,10C0,51C9,FFF0,0802
DATA 0000,6600,0008,3011,E948,1080,4CDF,030F
DATA 4E75,4E71,0000,03F2
REM decode
DATA 0000,0000,0000,0025,0000,03E9,0000,0025
DATA 48E7,F8F0,206F,0028,226F,002C,246F,0030
DATA 222F,0034,266F,0038,1010,0200,00F0,6600
DATA 0070,78FF,7400,5341,E249,6500,0006,343C
DATA 0001,7600,1018,E898,0240,000F,34C0,0C43
DATA 0000,6600,000C,0C00,0000,6600,0004,5284
DATA D640,E998,0240,000F,34C0,0C43,0000,6600
DATA 000C,0C40,0000,6600,0004,5284,D640,51C9
DATA FFC4,0802,0000,6600,000E,1010,E808,0240
DATA 000F,3480,D640,3283,3684,4CDF,0F1F,4E75
DATA 3480,60F6,0000,03F2

SUB decodiere(t$) STATIC
SHARED dec(),dat(),zmax,geszahl,bestZust
IF t$<>"" THEN
geszahl=0:bestZust=0
ass&=0
Adr&=0
gadr&=0
dadr&=0
bzadr&=0
Adr&=SADD(t$)
gadr&=VARPTR(geszahl)
dadr&=VARPTR(dat(0))
bzadr&=VARPTR(bestZust)
ass&=VARPTR(dec(0))
CALL ass&(Adr&,gadr&,dadr&,zmax,bzadr&)
END IF
END SUB
 
SUB codiere(t$) STATIC
SHARED cod(),ndat(),nzmax,nsatzl
t$=STRING$(nsatzl,0)
ass&=0
Adr&=0
dadr&=0
Adr&=SADD(t$)
dadr&=VARPTR(ndat(0))
ass&=VARPTR(cod(0))
CALL ass&(Adr&,dadr&,nzmax)
END SUB

500 
 CLS
 LOCATE 2,30:PRINT "neue Diskette einrichten"
 LOCATE 4,5:PRINT "Geben Sie bitte den vollständigen Pfad zur dos.library an:"
 INPUT lib$
 IF UCASE$(RIGHT$(lib$,11))="DOS.LIBRARY" THEN lib$=LEFT$(lib$,LEN(lib$)-11
 IF (RIGHT$(lib$,1)<>"/" AND RIGHT$(lib$,1)<>":")AND LEN(lib$)>0 THEN lib$=lib$+"/"
 ON ERROR GOTO libfehler
 LIBRARY lib$+"dos.library"
 ON ERROR GOTO 0
 LOCATE 6,5:PRINT "Legen Sie jetzt bitte eine formatierte Diskette ein (+ Taste)."
 taste
 fHandle& = xOpen&(SADD("con:0/0/600/100/"+CHR$(0)),1005)
 IF fHandle& = 0 THEN PRINT:PRINT  "Fehler im DOS":taste:LIBRARY CLOSE:GOTO 10
 x=Execute&(SADD("makedir df0:comdat"+CHR$(0)), 0,fHandle&)
 CALL xClose&(fHandle&)  
 LIBRARY CLOSE      
GOTO 10